home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / mdishe / main.bas < prev    next >
BASIC Source File  |  1994-12-28  |  15KB  |  535 lines

  1. ' ********************************************************
  2. '        MDI Standard Application Shell
  3. ' ********************************************************
  4. '
  5. ' SUMMARY
  6. ' -------
  7. ' This file is part of an MDI application "skeleton"
  8. ' created by John Blessing of Leigh Business Enterprises Ltd.
  9. '
  10. ' FEATURES
  11. ' --------
  12. ' Selection of application database.
  13. ' Compact/Repair of database.
  14. ' 'Helptips' on toolbar items.
  15. ' Support for Help files.
  16. ' MDI child forms tiling etc.
  17. ' Error trapping.
  18. ' 'Nag' screen support for shareware authors.
  19. ' Support for 3D dialogs (switched off in design mode
  20. '   to prevent GPFs)
  21. '
  22. ' USE
  23. ' ---
  24. ' You need VB Pro to use this shell, although it could be
  25. ' modified to run under the standard edition.
  26. '
  27. ' You will need to set up some information in APP.BAS,
  28. ' particularly in SetAppInfo().  You will also need to add
  29. ' your own application specific code to this module.
  30. '
  31. ' DISTRIBUTION
  32. ' ------------
  33. ' This program is "FreeWare" and may be used and distributed
  34. ' as you wish.
  35. '
  36. ' It incorporates some ideas/code from other authors and these
  37. ' are acknowledged in the appropriate module.
  38. '
  39. ' We hope that you will find it useful.  If you wish to discuss it
  40. ' then please e-mail us on Compuserve 100444,623.
  41. '
  42. ' ADVERTISEMENT!
  43. ' --------------
  44. ' Are you looking for a helpdesk system? Or does your company
  45. ' want to track and monitor the progress of any work activity?
  46. ' We market a system which could be of interest to you.
  47. '
  48. ' PROGRESS is available for download from the Business section
  49. ' of the Windows Shareware forum on Compuserve
  50. ' (filename PRGRSS10.ZIP).  It's a large program, so in the
  51. ' same section you will also find the help files and
  52. ' documentation as  PRGSSDOC.ZIP which is quicker to download
  53. ' and will give you a good idea of the functionality of PROGRESS.
  54. '
  55. ' Dec 1994
  56.  
  57. Option Explicit
  58.  
  59. Global sGNl As String * 2
  60. Global sGTab As String * 1
  61.  
  62. Global sGTable As String
  63. Global sGDbaseName As String
  64. Global sGFormTitle As String
  65. Global sGTempName As String
  66. Global iGHandle As Integer
  67. Global sGVersion  As String
  68.  
  69. 'Evaluation version stuff
  70. Global iGEvaluation As Integer
  71.  
  72.  
  73. Declare Function GetTextExtent Lib "GDI" (ByVal hDC As Integer, ByVal lpString As String, ByVal nCount As Integer) As Long
  74. Declare Function GetDC Lib "User" (ByVal hWnd As Integer) As Integer
  75. Declare Function ReleaseDC Lib "User" (ByVal hWnd As Integer, ByVal hDC As Integer) As Integer
  76. Declare Function SendMessage Lib "User" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Any) As Long
  77. Declare Function WinHelp Lib "User" (ByVal hWnd As Integer, ByVal lpHelpFile As String, ByVal wCommand As Integer, ByVal dwData As Any) As Integer
  78. Declare Function GetPrivateProfileInt Lib "Kernel" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal nDefault As Integer, ByVal lpFileName As String) As Integer
  79. Declare Function GetPrivateProfileString Lib "Kernel" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Integer, ByVal lpFileName As String) As Integer
  80. Declare Function WritePrivateProfileString Lib "Kernel" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpString As String, ByVal lplFileName As String) As Integer
  81. Declare Sub SetWindowPos Lib "User" (ByVal hWnd As Integer, ByVal hWndInsertAfter As Integer, ByVal X As Integer, ByVal Y As Integer, ByVal cx As Integer, ByVal cy As Integer, ByVal wFlags As Integer)
  82. Declare Function GetWindow Lib "User" (ByVal hWnd As Integer, ByVal code As Integer) As Integer
  83. Declare Sub MoveWindow Lib "User" (ByVal hWnd As Integer, ByVal l As Integer, ByVal t As Integer, ByVal w As Integer, ByVal h As Integer, ByVal redraw As Integer)
  84. Declare Function FindWindow Lib "User" (ByVal lpClassName As Any, ByVal lpWindowName As Any) As Integer
  85.  
  86.  
  87. Global Const WM_USER = &H400
  88. Global Const LB_SETTABSTOPS = WM_USER + 19
  89. Global Const WM_CLOSE = &H10
  90. Global Const GW_CHILD = 5
  91. Global Const SWP_NOMOVE = 2
  92. Global Const SWP_NOSIZE = 1
  93. Global Const HWND_TOPMOST = -1
  94. Global Const HWND_NOTOPMOST = -2
  95. Global Const GWW_HINSTANCE = (-6)
  96.  
  97.  
  98.  
  99. 'application information
  100. Type StdApp
  101.     sName               As String
  102.     sHelpFile           As String
  103.     sIniFile            As String
  104.     sErrorFile          As String
  105.     sOrderInfoFile      As String
  106.     dVersion            As Double
  107.     sDbaseName          As String
  108.     iToolButtonCount    As Integer
  109.     bEvaluation         As Integer
  110.  
  111. End Type
  112.   
  113. Global tGApp    As StdApp
  114.  
  115. 'returns 1 if password matches or if no password found in
  116. 'the system table
  117. Function CheckPassword () As Integer
  118. '     Dim Password As Variant
  119. '
  120. '     Err = False
  121. '     On Error GoTo ErrorCheckPassword
  122. '
  123. '     mdiMain!Data1.DatabaseName = tGApp.sDbaseName
  124. '     mdiMain!Data1.RecordSource = "Select * From System"
  125. '     mdiMain!Data1.Options = DB_READONLY
  126. '     mdiMain!Data1.Refresh
  127. '     If (mdiMain!Data1.Recordset.EOF And mdiMain!Data1.Recordset.BOF) Then
  128. '         MsgBox Error$
  129. '         CheckPassword = 0
  130. '         mdiMain!Data1.Database.Close
  131. '         Exit Function
  132. '     End If
  133. '
  134. '
  135. '     Password = "" & mdiMain!Data1.Recordset.Fields("[Delete Password]")
  136. '     mdiMain!Data1.Database.Close
  137. '     If Password = "" Then   'no password required
  138. '         CheckPassword = 1
  139. '         Exit Function
  140. '     Else    'there is a password
  141. '         'change the caption
  142. '         fPasswrd!lblExisting.Caption = "Please enter the password"
  143. '         'pass the password
  144. '         fPasswrd!lblHiddenPassword.Caption = Password
  145. '         'make invisible the new password boxes
  146. '         fPasswrd!lblNew1.Visible = False
  147. '         fPasswrd!lblNew2.Visible = False
  148. '         fPasswrd!txtNew1.Visible = False
  149. '         fPasswrd!txtNew2.Visible = False
  150. '         'allow entry of password
  151. '         fPasswrd!txtExisting.Enabled = True
  152. '         fPasswrd!txtExisting.Visible = True
  153. '         fPasswrd!lblExisting.Enabled = True
  154. '     End If
  155. '
  156. '
  157. '     fPasswrd.Show 1
  158. '
  159. '     If fPasswrd.Tag = Password Then 'correct
  160. '         CheckPassword = 1
  161. '     Else
  162. '         CheckPassword = 0
  163. '     End If
  164. '
  165. '     Unload fPasswrd
  166. '
  167. ' QuitCheckPassword:
  168. '     Exit Function
  169. '
  170. ' ErrorCheckPassword:
  171. '     MsgBox "Error: " & Error$ & sGNl & "Unable to check password."
  172. '     CheckPassword = 0
  173. '     Resume QuitCheckPassword
  174. '
  175. End Function
  176.  
  177. '======================================================================
  178. 'Form/Module:
  179. '   mdiMain
  180. '
  181. 'Procedure:
  182. '   ClearTitle
  183. '
  184. 'Parameters
  185. '   frmTarget   The form to set the caption on
  186. 'Modifications:
  187. '   23/12/94   JBL     Build
  188. '
  189. 'Description:
  190. '   Clears the form's title
  191. '
  192. '======================================================================
  193. '
  194. Sub ClearTitle (frmTarget As Form)
  195.  
  196.     'General Error Handler
  197.     If Not bDesignMode() Then
  198.     On Error GoTo Error_ClearTitle
  199.     End If
  200.     
  201.     
  202.     frmTarget.Caption = tGApp.sName & " Ver. " & CStr(tGApp.dVersion)
  203.     
  204.     Exit Sub
  205. Error_ClearTitle:
  206.     'call the generic error handler
  207.     GenErrorHandler "Main.bas - ClearTitle()", Err, Error$
  208. '
  209.     Resume Exit_ClearTitle
  210. '
  211. Exit_ClearTitle:
  212.  
  213. End Sub
  214.  
  215. '======================================================================
  216. 'Form/Module:
  217. '   Main.bas
  218. '
  219. 'Procedure:
  220. '   GetDefaultDb
  221. '
  222. 'Modifications:
  223. '   25/12/94   JBL     Build
  224. '
  225. 'Description:
  226. '   Reads the program's ini file and tries to find the database that was
  227. '   used last time
  228. '======================================================================
  229. '
  230. Sub GetDefaultDb ()
  231.     Dim iRetVal As Integer
  232.     Dim sRetVal As String
  233.     
  234.     'General Error Handler
  235.     If Not bDesignMode() Then
  236.     On Error GoTo Error_GetDefaultDb
  237.     End If
  238.     
  239.     'initialise
  240.     tGApp.sDbaseName = ""
  241.  
  242.     'fill default with 80 zeros
  243.     sRetVal = String$(80, 0)
  244.  
  245.     'read from the .ini in the user's window directory the path
  246.     'of the current database
  247.  
  248.     iRetVal = GetPrivateProfileString("Database", "Default", " ", sRetVal, 80, tGApp.sIniFile)
  249.